Attribute VB_Name = "modHookTableMouse"
Option Explicit

Private Declare Function SetWindowLong Lib "USER32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function CallWindowProc Lib "USER32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Long, ByVal Length As Long)
Private Const GWL_WNDPROC   As Long = (-4)
Private Const WM_MOUSEWHEEL As Long = &H20A

Private m_OldProc As Long
Private m_OldMouseProc As Long
Private m_OldProcStudent As Long

Private Type tpLong
    X As Integer
    Y As Integer
End Type

Public CtlWheel As MSFlexGrid
Public CtlMouse As MSFlexGrid

Public Sub HookTableWheel(hWnd As Long)
    m_OldProc = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WheelWindowProc)
End Sub

Public Sub UnHookTableWheel(hWnd As Long)
    Dim lngReturnValue As Long
    lngReturnValue = SetWindowLong(hWnd, GWL_WNDPROC, m_OldProc)
    Set CtlWheel = Nothing
End Sub

Public Sub HookTableMouse(tbl As MSFlexGrid)
    Set CtlMouse = tbl
    If m_OldMouseProc <> 0 Then Exit Sub
    
    m_OldMouseProc = SetWindowLong(tbl.hWnd, GWL_WNDPROC, AddressOf MouseWindowProc)
End Sub

Public Sub UnHookTableMouse(tbl As MSFlexGrid)
    If m_OldMouseProc = 0 Then Exit Sub
    Call SetWindowLong(tbl.hWnd, GWL_WNDPROC, m_OldMouseProc)
    m_OldMouseProc = 0
    Set CtlMouse = Nothing
End Sub

Private Function MouseWindowProc(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
On Error GoTo Err
    If wMsg = 513 Then
        If CtlMouse Is Nothing Then GoTo Err
        Dim t As tpLong
        
        CopyMemory t, lParam, 4&
        
        If t.Y > (CtlMouse.RowPos(CtlMouse.Rows - 1) + CtlMouse.RowHeight(CtlMouse.Rows - 1)) / Screen.TwipsPerPixelY Then
            Exit Function
        End If
    End If
Err:
    MouseWindowProc = CallWindowProc(m_OldMouseProc, hWnd, wMsg, wParam, lParam)
End Function

Private Function WheelWindowProc(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
On Error GoTo Err
    Select Case wMsg
    Case WM_MOUSEWHEEL
        If CtlWheel Is Nothing Then GoTo Err
        With CtlWheel
            Select Case wParam
            Case Is > 0
                If CtlWheel.TopRow > 0 Then
                    CtlWheel.TopRow = CtlWheel.TopRow - 5
                End If
            Case Else
                CtlWheel.TopRow = CtlWheel.TopRow + 5
            End Select
        End With
    End Select
Err:
    WheelWindowProc = CallWindowProc(m_OldProc, hWnd, wMsg, wParam, lParam)
End Function

Public Sub SelectRow(tbl As MSFlexGrid, rowIndex As Long)
    tbl.row = rowIndex
    tbl.Col = 0
    tbl.RowSel = rowIndex
    tbl.ColSel = tbl.Cols - 1
End Sub

Public Function GetSelectRowCount(tbl As MSFlexGrid, Optional ByRef selStart As Long, Optional ByRef selEnd As Long) As Long
    If tbl.row = tbl.RowSel Then
        GetSelectRowCount = tbl.row
        selStart = tbl.row
        selEnd = tbl.row
    ElseIf tbl.row > tbl.RowSel Then
        GetSelectRowCount = tbl.row - tbl.RowSel + 1
        selStart = tbl.RowSel
        selEnd = tbl.row
    Else
        GetSelectRowCount = tbl.RowSel - tbl.row + 1
        selStart = tbl.row
        selEnd = tbl.RowSel
    End If
End Function
